home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 051-075 / disk_065 / prep / demo.f next >
Text File  |  1992-05-06  |  2KB  |  77 lines

  1.       include 'tencomn'
  2.       call init
  3.       call skipdat( skip0 )
  4.       if (eoflag) call exodus
  5.       call menu
  6. 17500 continue
  7.       do 12500 j = 1, 10
  8.             record( j ) = 0
  9. 12500 continue
  10.       do 12501 j = 1, 10
  11.             icount = j
  12.             call getdat
  13.             record( icount ) = firstrecord
  14.       if (eoflag) goto 22501
  15.             if ( icount .eq. 1 ) then
  16.                call vsbcol(dev, backcol)
  17.                call vclrwk(dev)
  18.             end if
  19.             call compact
  20.             call windower
  21.             if ( (((xpix1-xpix0+1) .eq.  nrows) .and.  ((ypix1-ypix0+1) 
  22.      *.eq.  ncols)))  ) then
  23.                call pixie( HARDXDIM, nrows, ncols,
  24.      *                     xpix0, PHYSHEIGHT - 1 - ypix1,
  25.      *                     buffer )
  26.             else
  27.                call winfill( HARDXDIM, nrows, ncols,
  28.      *                       xpix0, xpix1,
  29.      *                       PHYSHEIGHT - 1 - ypix1,
  30.      *                       PHYSHEIGHT - 1 - ypix0,
  31.      *                       buffer )
  32.             end if
  33.             status = vsmstr( dev, ten, zero, echoxy, dummy)
  34.             if ( status .gt. 0 ) then
  35. 20000 continue
  36.       if (( upper( dummy(1:1) ) ).eq.( 'Q' )) then
  37.       call exodus
  38.       else if (( upper( dummy(1:1) ) ).eq.( 'R' )) then
  39.       goto 22501
  40.       else if (( upper( dummy(1:1) ) ).eq.( 'B' )) then
  41.       goto 22501
  42.       end if
  43.             end if
  44. 12501 continue
  45. 22501 continue
  46.          call skipdat( skip )
  47.          if ( moviemode ) then
  48.             if (eoflag) call exodus
  49.             call dump
  50.          else
  51. 17501 continue
  52. 20001 continue
  53.                lastkey = key(dev)
  54.       if (( lastkey ).eq.( 'D' )) then
  55.       call dump
  56.       goto 20001
  57.       else if (( lastkey ).eq.( 'Q' )) then
  58.       call exodus
  59.       else if (( lastkey ).eq.( 'R' )) then
  60.       call restart
  61.       else if (( lastkey ).eq.( 'B' )) then
  62.       call pop( recn )
  63.                                recn = max0( recn, 1 )
  64.                                eoflag = .false.
  65.       else
  66.       call push( max0( record(1), 1 ) )
  67.                                call enlarger
  68.       end if
  69.       if (.not.( eoflag )) goto 15001
  70.       goto 17501
  71. 15001 continue
  72.          end if
  73.       goto 17500
  74. 15000 continue
  75.       call exodus
  76.       end
  77.